Collection of Tools & Utilities/Collection of Tools and Utilities.iso/pascal/totsrc11.zip/TOTMENU.INC

Text File | 1993-05-04 | 14KB | 606 lines

{               Copyright 1991 TechnoJock Software, Inc.               }
{                          All Rights Reserved                         }
{                         Restricted by License                        }

{File TOTMENU.INC}

{|||||||||||||||||||||||||||||||||||||||||||||||}
{                                               }
{     B a s e M e n u O B J   M E T H O D S     }
{                                               }
{|||||||||||||||||||||||||||||||||||||||||||||||}
constructor BaseMenuOBJ.Init;
{}
begin
   vItemStack := nil;
   vTotalItems := 0;
   vActiveItem := 0;
   vAllowEsc := true;
   vUsedInPull := false;
   vMsgVisible := false;
   vSubActive := false;
   vMenuHiHot := LookTOT^.MenuHiHot;
   vMenuHiNorm := LookTOT^.MenuHiNorm;
   vMenuLoHot := LookTOT^.MenuLoHot;
   vMenuLoNorm := LookTOT^.MenuLoNorm;
   vMenuOff := LookTOT^.MenuOff;
   vPickOff := true;
   vGap := 2;
   vWidth := 0;
   vX := 0;
   vY := 0;
   vMsgX := 0;
   vMsgY := Monitor^.Depth;
   vHelpKey := 315;
   vhelpHook := NoHelpHook;
end; {BaseMenuOBJ.Init}

function BaseMenuOBJ.ItemPtr(Item:byte): MenuItemPtr;
{}
var
   Temp: MenuItemPtr;
   I: integer;
begin
   if (Item < 1) or (Item > vTotalItems) then
      ItemPtr := nil
   else
   begin
      Temp := vItemStack;
      if Item > 1 then
         for I := 2 to Item do
             if Temp <> nil then
                Temp := Temp^.NextNode;
      ItemPtr := Temp;
   end;
end; {BaseMenuOBJ.ItemPtr}

function BaseMenuOBJ.FirstActiveItem: byte;
{}
var
   Temp: MenuItemPtr;
   I: integer;
begin
   Temp := vItemStack;
   if Temp = nil then
      FirstActiveItem := 0
   else
   begin
      I := 1;
      while (Temp <> nil) and (Temp^.Active = false) do
      begin
         inc(I);
         Temp := Temp^.NextNode;
      end;
      FirstActiveItem := I;
   end;
end; {BaseMenuOBJ.FirstActiveItem}

procedure BaseMenuOBJ.AddFullItem(Txt:StrVisible; ID,HK:word; Msg:StrVisible; SubM:BaseMenuPtr);
{}
begin
   AddItem(Txt);
   SetID(vTotalItems,ID);
   SetHK(vTotalItems,HK);
   SetMessage(vTotalItems,Msg);
   SetSubMenu(vTotalItems,SubM);
end; {BaseMenuOBJ.AddFullItem}

procedure BaseMenuOBJ.AddItem(Txt:StrVisible);
{}
var
   Temp: MenuItemPtr;
   L : byte;
begin
   if MaxAvail < sizeof(vItemStack^)+succ(length(Txt)) then
      exit
   else
   begin
      if vItemStack = nil then
      begin
         getmem(vItemStack,sizeof(vItemStack^));
         vActiveItem := 1;
         Temp := vItemStack;
      end
      else
      begin
         Temp := ItemPtr(vTotalItems);
         getmem(Temp^.NextNode, sizeof(Temp^));
         Temp := Temp^.NextNode;
      end;
      Temp^.NextNode := nil;
      inc(vTotalItems);
      with Temp^ do
      begin
         L := succ(length(Txt));
         if L = 1 then
           TxtPtr := nil
         else
         begin
            if MemAvail >=  L then
            begin
               getmem(TxtPtr,L);
               move(Txt[0],TxtPtr^,L);
            end;
         end;
         MsgPtr := nil;
         HK :=  0;
         ID := 0;
         if (Txt = '-') or (Txt = '=') or (Txt = '') then
            Active := false
         else
            Active := true;
         SubMenu := nil;
      end;
      L := length(strip('A',Screen.HiMarker,Txt));
      if L > vWidth then
         vWidth := L;
   end;
end; {BaseMenuOBJ.AddItem}

procedure BaseMenuOBJ.SetTopic(Item:byte; Txt:StrVisible);
{}
var
   Temp: MenuItemPtr;
   L: byte;
begin
   Temp := ItemPtr(Item);
   if Temp <> nil then
   begin
      if Temp^.TxtPtr <> nil then
      begin
         move(Temp^.TxtPtr^,L,1);
         freemem(Temp^.TxtPtr,L);
      end;
      L := succ(length(Txt));
      if memavail >= L then
      begin
         if L = 1 then
           Temp^.TxtPtr := nil
         else
         begin
            getmem(Temp^.TxtPtr,L);
            move(Txt[0],Temp^.TxtPtr^,L);
         end;
      end;
   end;
end; {BaseMenuOBJ.SetTopic}

procedure BaseMenuOBJ.SetMessage(Item:byte; Msg:StrVisible);
{}
var
   Temp: MenuItemPtr;
   L: byte;
begin
   Temp := ItemPtr(Item);
   if Temp <> nil then
   begin
      if Temp^.MsgPtr <> nil then
      begin
         move(Temp^.MsgPtr^,L,1);
         freemem(Temp^.MsgPtr,L);
      end;
      L := succ(length(Msg));
      if memavail >= L then
      begin
         if L = 1 then
           Temp^.MsgPtr := nil
         else
         begin
            getmem(Temp^.MsgPtr,L);
            move(Msg[0],Temp^.MsgPtr^,L);
         end;
      end;
   end;
end; {BaseMenuOBJ.SetMessage}

procedure BaseMenuOBJ.SetHK(Item:byte; HK:word);
{}
var Temp: MenuItemPtr;
begin
   Temp := ItemPtr(Item);
   if Temp <> nil then
      Temp^.HK := HK;
end; {BaseMenuOBJ.SetHK}

procedure BaseMenuOBJ.SetID(Item:byte; ID:word);
{}
var Temp: MenuItemPtr;
begin
   Temp := ItemPtr(Item);
   if Temp <> nil then
      Temp^.ID := ID;
end; {BaseMenuOBJ.SetID}

procedure BaseMenuOBJ.SetStatus(Item:byte; On:boolean);
{}
var Temp: MenuItemPtr;
begin
   Temp := ItemPtr(Item);
   if Temp <> nil then
      Temp^.Active := On;
end; {BaseMenuOBJ.SetStatus}

procedure BaseMenuOBJ.SetSubMenu(Item:byte;SubMenu:BaseMenuPtr);
{}
var
  Temp: MenuItemPtr;
  L: byte;
  Str: StrVisible;
begin
   Temp := ItemPtr(Item);
   if Temp <> nil then
   begin
      Temp^.SubMenu := SubMenu;
      Str := GetText(Temp);
      L := succ(length(strip('A',Screen.HiMarker,Str)));
      if L > vWidth then
         vWidth := L;
   end;
end; {BaseMenuOBJ.SetSubMenu}

procedure BaseMenuOBJ.SetGap(G:byte);
{}
begin
   vGap := G;
end; {BaseMenuOBJ.SetGap}

procedure BaseMenuOBJ.SetActiveItem(Item:byte);
{}
begin
   if Item in [1..vTotalItems] then
      vActiveItem := Item;
end; {BaseMenuOBJ.SetActiveItem}

procedure BaseMenuOBJ.SetMessageXY(X,Y:byte);
{}
begin
   vMsgX := X;
   vMsgY := Y;
end; {BaseMenuOBJ.SetMessageXY}

procedure BaseMenuOBJ.SetMenuXY(X,Y:byte);
{}
begin
   vX := X;
   vY := Y;
end; {BaseMenuOBJ.SetMenuXY}

procedure BaseMenuOBJ.SetHelpKey(K:word);
{}
begin
   vHelpKey := K;
end; {BaseMenuOBJ.SetHelpKey}

procedure BaseMenuOBJ.SetAllowEsc(On:boolean);
{}
begin
   vAllowEsc := On;
end; {BaseMenuOBJ.SetAllowEsc}

procedure BaseMenuOBJ.SetColors(HiHot,HiNorm,LoHot,LoNorm,Off:byte);
{}
begin
   vMenuHiHot := HiHot;
   vMenuHiNorm := HiNorm;
   vMenuLoHot := LoHot;
   vMenuLoNorm := LoNorm;
   vMenuOff := Off;
end; {BaseMenuOBJ.SetColors}

function BaseMenuOBJ.GetAllowEsc: boolean;
{}
begin
   GetAllowEsc := vAllowEsc;
end; {BaseMenuOBJ.GetAllowEsc}

function BaseMenuOBJ.GetText(Ptr:MenuItemPtr): StrVisible;
{}
var
  Str: StrVisible;
  L : byte;
begin
   Str := '';
   if Ptr <> nil then
      if Ptr^.TxtPtr <> nil then
      begin
         move(Ptr^.TxtPtr^,L,1);
         if L > 0 then
            move(Ptr^.TxtPtr^,Str,succ(L));
      end;
   GetText := Str;
end; {BaseMenuOBJ.GetText}

function BaseMenuOBJ.GetMessage(Ptr:MenuItemPtr): StrVisible;
{}
var
  Str: StrVisible;
  L : byte;
begin
   Str := '';
   if Ptr <> nil then
      if Ptr^.MsgPtr <> nil then
      begin
         move(Ptr^.MsgPtr^,L,1);
         if L > 0 then
            move(Ptr^.MsgPtr^,Str,succ(L));
      end;
   GetMessage := Str;
end; {BaseMenuOBJ.GetMessage}

function BaseMenuOBJ.GetID(Item:byte):word;
{}
var Temp: MenuItemPtr;
begin
   Temp := ItemPtr(Item);
   if Temp <> nil then
      GetID := Temp^.ID
   else
      GetID := 0;
end; {BaseMenuOBJ.GetID}

function BaseMenuOBJ.GetHelpID:word;
{}
var
  Temp: MenuItemPtr;
   Sub: BaseMenuPtr;
begin
   Temp := ItemPtr(vActiveItem);
   if Temp <> nil then
   begin
      Sub := Temp^.Submenu;
      if (Sub <> nil) and vSubActive then
         GetHelpID := Sub^.GetHelpID
      else
         GetHelpID := Temp^.ID;
   end
   else
      GetHelpID := 0;
end; {BaseMenuOBJ.GetHelpID}

function BaseMenuOBJ.GetActiveItem: byte;
{}
begin
   GetActiveItem := vActiveItem;
end